home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 126-150 / scopedisk126 / atoolsm2 / atoolimp < prev    next >
Encoding:
Modula Implementation  |  1995-03-19  |  32.8 KB  |  885 lines
  1. IMPLEMENTATION MODULE AudioTools; (* BASED ON AUDIOTOOLS RELEASE.3 by Rob Peck*)
  2.                               (* adapted to M2Amiga Modula-2 by Anthony Bryant*)
  3. FROM SYSTEM IMPORT
  4.  ADDRESS,ADR,BYTE,LONGSET;
  5. FROM Audio IMPORT
  6.  free, perVol, allocate,                 (* ADCMD_  commands *)
  7.  pervol, syncCycle, noWait, writeMessage,   (* ADIOF_  flags *)
  8.  IOAudio;  
  9. FROM Dos  IMPORT
  10.  Delay;
  11. FROM Exec IMPORT
  12.  invalid,reset,read,write,update,clear,stop,start,flush, (* IOAudio cmds *)
  13.  quick, (* IOF_ flags *)
  14.  IORequest, Message, MsgPortPtr, Node, TaskPtr, UnitPtr, DevicePtr,
  15.  UByte, Byte, MemReqs, MemReqSet,
  16.  AllocMem, CloseDevice, FindTask, FreeMem, GetMsg, OpenDevice,
  17.  PutMsg, WaitIO, WaitPort;
  18. FROM ExecSupport IMPORT
  19.  BeginIO, CreatePort, DeletePort;
  20.  
  21.   
  22. CONST
  23.  waveSize=512; (* byte size of allocated memory for waves ONLY *)
  24.  
  25. TYPE
  26.  auMsg=RECORD
  27.   message: Message;
  28.   identifier: LONGINT;   (* matches the bottom of ExtIOB *)
  29.  END;
  30.  auMsgPtr=POINTER TO auMsg;
  31.  
  32. VAR
  33.  unit: ARRAY [0..maxChan-1] OF UnitPtr;  (* global pointers to Units *)
  34.  key:  ARRAY [0..maxChan-1] OF INTEGER;  (* global value for alloc keys *)
  35.  usertask: ARRAY [0..maxChan-1] OF TaskPtr; (* user owns which channels *)
  36.  (* in preparation for making this a shared library (loadable from disk) *)
  37.  
  38.  openIOB: IOAudio;        (* IOB to open and close the device *)
  39.  device: DevicePtr;       (* global pointer to audio device   *)
  40.  controlPort: MsgPortPtr; (* Port for ControlChannel functions *)
  41.  
  42.  audbuffer: ARRAY [0..audBuffers-1] OF ExtIOB;    (* global, static buffers    *)
  43.  inuse:     ARRAY [0..audBuffers-1] OF BOOLEAN; (* keep track of statics used *)
  44.  chipaudio: ARRAY [0..maxChan-1] OF ADDRESS;   (* pntrs to waves in CHIP RAM *)
  45.  datalength: ARRAY [0..maxChan-1] OF LONGINT;  (* length of data in CHIP RAM *)
  46.  replyPort: ARRAY [0..maxChan-1] OF MsgPortPtr;   (* one ReplyPort per chan  *)
  47.  dynamix:   ARRAY [0..maxChan-1] OF LONGINT;  (* keep track of dynamics used *)
  48.  
  49.  anychan:     ARRAY [0..maxChan-1] OF UByte;  (* channel masks for mono *)
  50.  
  51.  dynamicName: ADDRESS; (* "dynamic" IOB's *)
  52.  globalName: ADDRESS;  (* "global" ( really "static") IOB's *)
  53.  
  54.     (* Each waveform buffer contains 8 octaves of the wave.  *)
  55.  
  56. woffsets: ARRAY [0..8] OF CARDINAL; (* where waveform for that octave begins. *)
  57. wlen: ARRAY [0..8] OF CARDINAL;    (* length of each waveform within a buffer *)
  58. perval: ARRAY [0..12] OF CARDINAL; (* Period of these notes within an octave. *)
  59.  
  60.  
  61.  
  62. (*------------------- internal   procedures ------------------------*)
  63.  
  64. (* FreeIOB - free a global (really static) or a dynamic, allocated IOB *)
  65.  
  66. PROCEDURE FreeIOB(iob: ExtIOBPtr; channel: LONGINT);
  67.  VAR
  68.    i: CARDINAL;
  69.  BEGIN
  70.    IF (iob^.request.message.node.name = dynamicName) THEN
  71.      FreeMem(iob, SIZE(iob^));
  72.      IF (dynamix[channel] # 0) THEN
  73.        DEC(dynamix[channel]); (* subtract one if nonzero *)
  74.      END;
  75.    ELSIF (iob^.request.message.node.name = globalName) THEN
  76.      i:= iob^.request.message.length;
  77.      IF (i < audBuffers) THEN
  78.     inuse[i]:= FALSE;   (* frees this one for reuse *)
  79.      END;
  80.    END;
  81.  END FreeIOB;
  82.  
  83. (* ReEmployIOB - look at ALL of the reply ports and if any IOBs
  84.  * hanging around with nothing to do, then free them.
  85.  *
  86.  * Audio may still be playing the waveform as we get a message
  87.  * through MayGetNote.  MayGetNote marks the iob message block as free-able,
  88.  * (when it finds that the identifier field is set to zero) but we have
  89.  * to have a way of recirculating in this list of messages.
  90.  *
  91.  * In other words, if something is free-able, free it, otherwise leave it
  92.  * on the list.  So rather than removing things from the front of the list,
  93.  * lets just walk through the message list, remove (dequeue) what is 
  94.  * freeable and leave the rest there to look at the next time.
  95.  *)
  96.  
  97. PROCEDURE ReEmployIOB();
  98.  VAR
  99.    i: LONGINT;
  100.    mp: MsgPortPtr;
  101.    iob: ExtIOBPtr;
  102.    pushback: ExtIOBPtr;    
  103.  
  104.    (* What happens here is that iob's are removed from the message port
  105.     * when they come back from the audio device.   If YOU have set the
  106.     * messageport nonzero, it means that you wanted to know when
  107.     * this note began to play.  The WriteMsg part of the iob is then
  108.     * linked, as a message, onto your user port.  So this routine 
  109.     * cannot free the iob until it is certain that YOU have finished
  110.     * using it.  The iob_Priority field is READ here.  If it still
  111.     * nonzero, the iob is pushed back onto the message port (on the
  112.     * end of the message queue) to be read again.  We hold a pointer
  113.     * named "pushback" that lets us keep track of when we see that
  114.     * again.  If we see it twice, it means we have completed a full
  115.     * circle through the queue of messages and have freed everything
  116.     * that we can this time.  Therefore, we examine it and either
  117.     * free it or push it back again, then exit.
  118.     *)
  119.  
  120.  BEGIN    
  121.    FOR i:=0 TO maxChan-1 BY 1 DO
  122.       (* remove all iob's from ALL ports, unless we have to push one back *)
  123.       mp:= replyPort[i];
  124.       
  125.       pushback:= NIL;    (* nothing pushed back so far *)
  126.       
  127.       iob:= ExtIOBPtr(GetMsg(mp));
  128.       WHILE (iob # NIL) DO
  129.      (* First see if messageport in writeMsg is not NIL;           *)
  130.      (* if so, audio device is done, but user has not acknowledged *)
  131.      (* this message yet (by using MayGetNote). *)
  132.             
  133.     IF (iob^.writeMsg.replyPort # NIL) THEN
  134.        PutMsg(mp, iob);
  135.        IF ((iob # pushback) AND (pushback = NIL)) THEN
  136.              pushback:= iob;  (* Remember FIRST one pushed back *)
  137.        END;
  138.     ELSE
  139.            FreeIOB(iob,i); (* messageport is NIL, can free the iob *)
  140.     END;
  141.       iob:= ExtIOBPtr(GetMsg(mp));
  142.       END;
  143.    END;
  144. END ReEmployIOB;
  145.  
  146. (* GetIOB - allocate an IOB , global (really static)  or dynamic for use. *)
  147.  
  148. PROCEDURE GetIOB(channel: LONGINT): ExtIOBPtr;
  149.  VAR
  150.    i, usereply: CARDINAL;
  151.    iob: ExtIOBPtr;     (* in case we need to allocate one *)
  152.  BEGIN
  153.    ReEmployIOB();      (* find already used ones and free them *)
  154.  
  155.    IF (channel = -1) THEN usereply:= 0; ELSE usereply:= channel; END;
  156.    
  157.    (* try to allocate a global (really static) iob to use *)
  158.    FOR i:=0 TO audBuffers-1 BY 1 DO   
  159.       IF (inuse[i] = FALSE) THEN
  160.         (* we have our global (really static), so assign parameters *)
  161.     inuse[i]:= TRUE;
  162.     audbuffer[i].request.device:= device;
  163.     audbuffer[i].request.message.replyPort:= replyPort[usereply];
  164.     audbuffer[i].request.message.length:= i;
  165.     audbuffer[i].request.message.node.name:= globalName;
  166.        RETURN ADR(audbuffer[i]);
  167.       END;
  168.    END;
  169.    
  170.    (* if all globals (really statics) are in use, try to allocate dynamic one *)
  171.    iob:= ExtIOBPtr(AllocMem(SIZE(iob^), MemReqSet{memClear}));
  172.    IF (iob = NIL) THEN RETURN NIL; END;   (* out of memory *)
  173.       (* we have our dynamic, so assign parameters *)   
  174.        iob^.request.device:= device;
  175.        iob^.request.message.replyPort:= replyPort[usereply];
  176.        iob^.request.message.node.name:= dynamicName;
  177.        iob^.request.message.length:= dynamix[usereply];
  178.        INC(dynamix[usereply]); (* add one to number allocated to a channel *)
  179.     RETURN iob;
  180.  END GetIOB;
  181.  
  182.  
  183. (* CheckIOBDone - to see if all iob's are finished (i.e. freed up)
  184.  * if TRUE then everything IS finished.
  185.  *)
  186.  
  187. PROCEDURE CheckIOBDone(): BOOLEAN;
  188.  VAR
  189.    i, status: LONGINT;
  190.  BEGIN
  191.    status:= 0;   (* means there are still some iob's in play *)
  192.                  (* when status = 4, then everything is free *)
  193.  
  194.    FOR i:=0 TO audBuffers-1 BY 1 DO
  195.      IF (inuse[i] = TRUE) THEN
  196.      (* Sooner or later, this will catch both
  197.           * the statics and dynamics.  Note that
  198.           * this will only work if NO (REPEAT: NO)
  199.           * iob's sent off with a duration value
  200.           * of "0", because zero means "forever"
  201.           *)
  202.         ReEmployIOB();
  203.      END;
  204.    END;
  205.    (* Note to implementors... maintaining inuse[i] now seems
  206.     * like a lousy idea, unless it is accompanied by a variable
  207.     * statics_inplay that decrements to zero when all statics
  208.     * are done.  That makes it much easier to check than going
  209.     * through all of the inuse[]'s.  Maybe not.
  210.     *)
  211.  
  212.    FOR i:=0 TO maxChan-1 BY 1 DO
  213.      IF (dynamix[i] > 0) THEN 
  214.                  (* If this channel still playing a   *)
  215.                  (* dynamically allocated block, wait *)
  216.                  (* for all messages to return before *)
  217.                  (* the program exits.                *)
  218.         ReEmployIOB();  (* take another shot at freeing it all *)  
  219.      END;
  220.    END;
  221.    
  222.    FOR i:=0 TO maxChan-1 BY 1 DO   (* Check again as we nearly exit *)
  223.      IF (dynamix[i] = 0) THEN INC(status); END;
  224.    END;
  225.    IF (status = 4) THEN     (* All dynamics are free, now check the statics *)
  226.      FOR i:=0 TO audBuffers-1 BY 1 DO
  227.        IF (inuse[i] = TRUE) THEN RETURN FALSE; END;     (* some not free *)
  228.      END;
  229.      RETURN TRUE;   (* DONE! *)
  230.    ELSE
  231.      RETURN FALSE;  (* still some out there! *)
  232.    END;
  233.  END CheckIOBDone;
  234.  
  235. (* -------------- USER  support  procedures ----------------- *)
  236.  
  237. (* InitAudio returns, uport, a pointer to a message port at which your task
  238.  *  receives a message when a particular note BEGINS to play.
  239.  * You must save this value somewhere, and use it to call MayGetNote
  240.  *  or FinishAudio.  MayGetNote is the name of the routine that you call
  241.  * to check if a note has begun to play.  If an error occurs (can't Opendevice
  242.  *  or CreatePorts) then pointer = NIL
  243.  *)
  244.  
  245. PROCEDURE InitAudio(): MsgPortPtr;
  246.  VAR
  247.    error,i: LONGINT;
  248.    firstuser: BOOLEAN;    (* THIS WILL GET MOVED when shared library is made *)
  249.  BEGIN
  250.    firstuser:= TRUE;
  251.  
  252.    FOR i:=0 TO audBuffers-1 BY 1 DO
  253.      inuse[i]:= FALSE;      (* declare all message blocks are available *)
  254.    END;
  255.                        
  256.    openIOB.length:= 0;   (* Open device but don't allocate channels *)
  257.    OpenDevice(ADR("audio.device"),0,ADR(openIOB),LONGSET{0});
  258.    (* returns error in io_Error field; should be 0 *)
  259.    error:= LONGINT(openIOB.request.error);  (* IOERR_OPENFAIL  -1 *)
  260.    IF (error # 0) THEN RETURN NIL; END;
  261.    device:= openIOB.request.device; (* Get the device address for later use *)
  262.    
  263.    FOR i:=0 TO maxChan-1 BY 1 DO 
  264.      replyPort[i]:= CreatePort(0,0);  (* ports for replies from each channel *) 
  265.      IF (replyPort[i] = NIL) THEN RETURN NIL; END;
  266.      
  267.      chipaudio[i]:= 0;  (* have not yet created the waves/samples *)
  268.      datalength[i]:= 0; (* length of wave/sample data in CHIP RAM *)
  269.      dynamix[i]:= 0;   (* no dynamic I/O blocks allocated *) 
  270.      
  271.      (* When implemented as a shared library, "firstuser" will only *)
  272.      (* be TRUE when the library is first opened. *)
  273.   
  274.      IF (firstuser = TRUE) THEN    
  275.        key[i]:= 0;         (* init key values *)
  276.        unit[i]:= NIL;      (* init unit values *)
  277.        usertask[i]:= NIL;  (* no channel owned by any task *)
  278.      END;
  279.    END;
  280.    
  281.    controlPort:= CreatePort(0,0);  (* use for control & syncronous functions *)
  282.    IF (controlPort = NIL) THEN RETURN NIL; END;
  283.  
  284.       (* init anychan ARRAY for use by GetChannel *)
  285.   anychan[0]:=1; anychan[1]:=2; anychan[2]:=4; anychan[3]:=8;
  286.       (* init waveform buffer offsets ARRAY for use by PlayNote *)
  287.   woffsets[0]:=0; woffsets[1]:=256; woffsets[2]:=384; woffsets[3]:=448;
  288.   woffsets[4]:=480; woffsets[5]:=496; woffsets[6]:=504; woffsets[7]:=508;
  289.   woffsets[8]:=510;
  290.       (* init length of each waveform in a buffer ARRAY *)
  291.   wlen[0]:=256; wlen[1]:=128; wlen[2]:=64; wlen[3]:=32; wlen[4]:=16;
  292.   wlen[5]:=8  ; wlen[6]:=4;   wlen[7]:=2;  wlen[8]:=1;
  293.       (* init period value to go with note within an octave *)
  294.   perval[0]:=428; perval[1]:=404; perval[2]:=381; perval[3]:=360;
  295.   perval[4]:=339; perval[5]:=320; perval[6]:=302; perval[7]:=285;
  296.   perval[8]:=269; perval[9]:=254; perval[10]:=240; perval[11]:=226;
  297.   perval[12]:=214;
  298.       dynamicName:= ADR("dynamic");
  299.       globalName := ADR("global");
  300.           
  301.   RETURN CreatePort(0,0); (* my user port *)
  302.  END InitAudio;
  303.  
  304.  
  305. (*----------------  USER  support  procedures  ----------------- *)
  306.   
  307. (* GetChannel:  To request "any" channel, use channel = -1;
  308.  * To request a specific channel, use channel = 0, 1, 2 or 3;
  309.  * Again NOTE, this returns two globals as well as the channel number!
  310.  *)
  311.  
  312. PROCEDURE GetChannel(channel: LONGINT): LONGINT;
  313.  VAR
  314.    error, channum: LONGINT;
  315.    addrmsg: ADDRESS;
  316.    iob: ExtIOBPtr;
  317.    controlIOB: ExtIOB;
  318.  BEGIN
  319.    iob:= ADR(controlIOB);
  320.    iob^.request.device:= device;
  321.    iob^.request.message.replyPort:= controlPort;
  322.    iob^.allocKey:= 0; (* zero for new key *)
  323.    iob^.request.message.node.pri:= 20;
  324.  
  325.    IF (channel = -1) THEN
  326.      iob^.data:= ADR(anychan[0]);
  327.      iob^.length:= 4;
  328.    ELSIF ((channel >=0) AND (channel < maxChan)) THEN
  329.  
  330.             (* NOTE ***** ENHANCEMENT COMING HERE ***** *)
  331.  
  332.       IF (usertask[channel] # NIL) THEN RETURN (notYourChannel); END;
  333.  
  334.     (* Enhancement might be: look at the running priority
  335.       * of the current task as compared to the running priority
  336.      * of the task in usertask[i].  If not same task and if
  337.      * the current task has a higher priority, STEAL the channel!
  338.      * Alternative (seems better) is to have a global variable
  339.      * called audPriority to be set by a new function SetAudPriority
  340.      * (for a given task only), and that global priority value
  341.      * would be used for GetChannel and LockChannel requests.
  342.      *)
  343.      iob^.data:= ADR(anychan[channel]);
  344.      iob^.length:= 1;
  345.    
  346.    ELSE   (* chose a bad channel number; cannot allocate it *)
  347.      RETURN (badChannelSelected);
  348.    END;
  349.    iob^.request.command:= allocate;  (* ADCMD_ALLOCATE *)
  350.    iob^.request.flags:= noWait + quick; (* ADIOF_NOWAIT | IOF_QUICK *)
  351.    BeginIO(iob); 
  352.    WaitIO(iob);  (* returns error in io_Error field; should be 0  *)
  353.    error:= LONGINT(iob^.request.error);  (* ADIOERR_NOALLOCATION  -10 *)
  354.    IF (error # 0) THEN RETURN error; END;
  355.  (* WaitIO, just above, removes the message from the port. No need of GetMsg *)
  356.  
  357.    CASE LONGINT(iob^.request.unit) OF
  358.      1 :   channum:= 0;  |
  359.      2 :   channum:= 1;  |
  360.      4 :   channum:= 2;  |
  361.      8 :   channum:= 3;
  362.    ELSE
  363.      RETURN (badChannelSelected);
  364.    END;
  365.    unit[channum]:= iob^.request.unit;
  366.    key[channum]:= iob^.allocKey;
  367.    usertask[channum]:= FindTask(0);    (* THIS user task owns it now *)
  368.  
  369.    RETURN channum;  (* valid channel number (0-3) *)
  370.  END GetChannel;
  371.  
  372.  
  373. (* Use IsThatMyChan  to determine if you (still) own a particular channel.
  374.  * The audio device has an arrangement by which a higher priority request
  375.  * for a channel than the one that already owns it can be made.  The higher
  376.  * priority request can actually cause a channel to be stolen from a user.
  377.  * This feature may be implemented in a future version of audiotools,
  378.  * (shared library version), in which, depending on the task's running
  379.  * priority itself, a higher priority task could succeed at GetChannel
  380.  * for a channel that is already owned by another task.
  381.  *)
  382.  
  383. PROCEDURE IsThatMyChan(channel: LONGINT): LONGINT;    
  384.  BEGIN
  385.   IF ((channel < 0) OR (channel > maxChan-1)) THEN RETURN (badChannelSelected);
  386.   ELSIF (usertask[channel] # FindTask(0)) THEN RETURN (notYourChannel); END;
  387.   RETURN 0;     (* if YOU still own the channel *)
  388. END IsThatMyChan;
  389.  
  390.  
  391. (* ------------------ internal procedure use only -------------------- *)
  392.  
  393. PROCEDURE ControlChannel(channel: LONGINT; command: CARDINAL): LONGINT;
  394.  VAR
  395.    error: LONGINT;
  396.    iob: ExtIOBPtr;
  397.    controlIOB: ExtIOB;
  398.  BEGIN
  399.    error:= IsThatMyChan(channel);
  400.    IF (error # 0) THEN RETURN error; END;
  401.  
  402.    iob:= ADR(controlIOB);
  403.    iob^.request.device:= device;
  404.    iob^.request.message.replyPort:= controlPort;
  405.    iob^.request.unit:= unit[channel];
  406.    iob^.allocKey:= key[channel];
  407.  
  408.    iob^.request.command:= command;  (* CMD_xxxxx *)
  409.    IF (command = free) THEN
  410.      iob^.request.flags:= noWait + quick; (* ADIOF_NOWAIT |  IOF_QUICK *)
  411.    ELSE
  412.      iob^.request.flags:= quick;      (* IOF_QUICK *)  
  413.    END;  
  414.    BeginIO(iob);
  415.    WaitIO(iob);  (* returns error in io_Error field; should be 0 *)
  416.    error:= LONGINT(iob^.request.error); (* ADIOERR_NOALLOCATION -10 *)
  417.    RETURN error;
  418.  END ControlChannel;
  419.  
  420. (* ----------------- USER  support  procedures -------------------- *)
  421.  
  422. PROCEDURE StartChannel(channel: LONGINT): LONGINT;
  423.  BEGIN
  424.   RETURN ControlChannel(channel, start);
  425.  END StartChannel;
  426.   
  427. PROCEDURE StopChannel(channel: LONGINT): LONGINT;
  428.  BEGIN
  429.   RETURN ControlChannel(channel, stop);
  430.  END StopChannel;
  431.   
  432. PROCEDURE ResetChannel(channel: LONGINT): LONGINT;
  433.  BEGIN
  434.   RETURN ControlChannel(channel, reset);
  435.  END ResetChannel;
  436.   
  437. PROCEDURE FlushChannel(channel: LONGINT): LONGINT;
  438.  BEGIN
  439.   RETURN ControlChannel(channel, flush);
  440.  END FlushChannel;  
  441.   
  442. PROCEDURE FreeChannel(channel: LONGINT): LONGINT;
  443.  VAR
  444.    error: LONGINT;
  445.  BEGIN
  446.    error:= ControlChannel(channel, free);
  447.    IF (error # 0) THEN RETURN error; END;
  448.    usertask[channel]:= NIL;    (* free again... *)
  449.    RETURN 0;  (* everything o.k *)
  450.  END FreeChannel;
  451.  
  452.  
  453. (* CheckIfDone - to see if everything is finished BEFORE calling FinishAudio *)
  454.  
  455. PROCEDURE CheckIfDone(): BOOLEAN;
  456.  BEGIN
  457.    RETURN CheckIOBDone();
  458.  END CheckIfDone;  
  459.     
  460. (* Set Period and Volume of a note that is playing.  *)
  461.  
  462. PROCEDURE SetPV(channel: LONGINT; period, volume: CARDINAL): LONGINT;
  463.  VAR
  464.    error: LONGINT;
  465.    iob: ExtIOBPtr;
  466.    controlIOB: ExtIOB;
  467.  BEGIN
  468.    error:= IsThatMyChan(channel);
  469.    IF (error # 0) THEN RETURN error; END;
  470.  
  471.    iob:= ADR(controlIOB);
  472.    iob^.request.device:= device;
  473.    iob^.request.message.replyPort:= controlPort;
  474.    iob^.request.unit:= unit[channel];
  475.    iob^.allocKey:= key[channel];
  476.    
  477.    iob^.period:= period; (* new period *)
  478.    iob^.volume:= volume; (* new volume *)
  479.    
  480.    iob^.request.command:= perVol;  (* ADCMD_PERVOL *)
  481.    iob^.request.flags:= quick + pervol; (* IOF_QUICK | ADIOF_PERVOL *)
  482.    BeginIO(iob);    (* This one will be synchronous;  *)
  483.      (* affects whatever is playing on this channel at this time. *)
  484.    WaitIO(iob);   (* OK to wait, since it will return *)
  485.    error:= LONGINT(iob^.request.error);   (* ADIOERR_NOALLOCATION -10 *)
  486.    RETURN error;  (* error in io_Error field; should be 0 *)
  487. END SetPV;
  488.  
  489. (* SetWave creates CHIP RAM, if neccassary (only once per channel)
  490.  * and copies to CHIP RAM (with expand wave) users ARRAY [0..255] OF BYTE,
  491.  * where each element in ARRAY must be in the range -128 to 127  since
  492.  * audio DMA retrieves one word (16 bits) at a time and reads two bytes
  493.  *)
  494.  
  495. PROCEDURE SetWave(channel: LONGINT;
  496.               VAR waveform: ARRAY OF BYTE): LONGINT;
  497.  VAR
  498.    error: LONGINT;
  499.    i, j, rate: CARDINAL;
  500.    tmptr: ADDRESS;  (* where ADDRESS = POINTER TO BYTE *)
  501.  BEGIN  
  502.    error:= IsThatMyChan(channel);
  503.    IF (error # 0) THEN RETURN error; END;
  504.    
  505.    IF (chipaudio[channel] # 0) THEN  (* not first time *)
  506.      IF (datalength[channel] # waveSize) THEN (* must be sample *)
  507.        FreeMem(chipaudio[channel], datalength[channel]);
  508.        chipaudio[channel]:= 0; datalength[channel]:= 0;
  509.      END;
  510.    END;  
  511.    IF (chipaudio[channel] = 0) THEN   (* only allocate if neccessay! *)
  512.      chipaudio[channel]:= AllocMem(waveSize, MemReqSet{chip, memClear});
  513.      IF (chipaudio[channel] = 0) THEN RETURN (outOfMemory); END;
  514.      datalength[channel]:= waveSize; (* for use by FreeMem *)
  515.    END;
  516.        (* ok so far, now copy array to CHIP RAM (with expand wave)   *)  
  517.    tmptr:= chipaudio[channel];
  518.    rate:= 1;
  519.    FOR i:= 0 TO 8 BY 1 DO
  520.      j:= 0;
  521.      REPEAT   (* replicate waves in decreasing sample sizes *)
  522.        tmptr^:= waveform[j]; INC(tmptr);  (* increment address *)
  523.        j:= j + rate;
  524.      UNTIL j > 255;
  525.      rate:= rate * 2;  
  526.    END;   
  527.   RETURN 0;  (* O.K. *)
  528. END SetWave;
  529.  
  530.  
  531. (* SetSamp creates CHIP RAM, if neccassary (only once per channel)
  532.  * unless "length"= 0 which just frees up existing sample CHIP RAM or...
  533.  * copies byte by byte from users supplied "sampleaudio" to CHIP RAM,
  534.  * unless "sampleaudio"= 0 which just creates CHIP RAM (without copying)
  535.  * and returns new "sampleaudio" to user, (useful if samples loaded from disk)
  536.  * Note each element in "sampleaudio" must be in the range -128 to 127 since
  537.  * audio DMA retrieves one word (16 bits) at a time and reads two bytes
  538.  *)
  539.  
  540. PROCEDURE SetSamp(channel: LONGINT;
  541.               VAR sampleaudio: ADDRESS; (* returns new address *)
  542.                   length: LONGINT): LONGINT;
  543.  VAR
  544.    error: LONGINT;
  545.    j: LONGINT;
  546.    chiptr, samptr: ADDRESS;  (* where ADDRESS = POINTER TO BYTE *)
  547.  BEGIN  
  548.    error:= IsThatMyChan(channel);
  549.    IF (error # 0) THEN RETURN error; END;
  550.    
  551.    IF (chipaudio[channel] # 0) THEN   (* free up old mem *)
  552.      FreeMem(chipaudio[channel], datalength[channel]);
  553.      chipaudio[channel]:= 0; datalength[channel]:= 0;
  554.    END;  
  555.    IF (length = 0) THEN RETURN 0; END;  (* just free up old mem *)
  556.    IF (length > 131072) THEN length:= 131072; END; (* limit length *)
  557.    
  558.    IF (chipaudio[channel] = 0) THEN   (* only allocate once per channel! *)
  559.      chipaudio[channel]:= AllocMem(length, MemReqSet{chip, memClear});
  560.      IF (chipaudio[channel] = 0) THEN RETURN (outOfMemory); END;
  561.      datalength[channel]:= length;  (* for use by FreeMem *)
  562.    END;
  563.    IF (sampleaudio = 0) THEN sampleaudio:= chipaudio[channel]; RETURN 0; END;
  564.    
  565.    (* ok so far, length and sampleaudio nonzero, now copy to CHIP RAM   *)  
  566.    chiptr:= chipaudio[channel];
  567.    samptr:= sampleaudio;
  568.    FOR j:= 1 TO length BY 1 DO
  569.        chiptr^:= samptr^; INC(chiptr); INC(samptr);  (* increment address *)
  570.    END;   
  571.   RETURN 0;  (* O.K. *)
  572. END SetSamp;
  573.  
  574.     
  575. (* -------------- internal procedure use only ------------------*)
  576.  
  577. PROCEDURE PlayXXXX(channel: LONGINT;
  578.                    wfptr:   ADDRESS;  (* pointer to waveform in CHIP RAM *)
  579.                    len:     LONGCARD;
  580.                    per:     CARDINAL;
  581.                    vol:     CARDINAL;
  582.                    cycles:  CARDINAL;
  583.                    priority:   Byte;
  584.                    messageport: MsgPortPtr;
  585.                    id: LONGINT):   LONGINT;
  586.  VAR
  587.    error: LONGINT;
  588.    iob: ExtIOBPtr;
  589.  BEGIN
  590.    iob:= GetIOB(channel);
  591.    IF (iob # NIL) THEN  (* set the parameters *)
  592.       iob^.request.unit:= unit[channel];
  593.       iob^.allocKey:= key[channel];
  594.       iob^.data:= wfptr;
  595.       iob^.length:= len;
  596.       iob^.period:= per;
  597.       iob^.volume:= vol;
  598.       iob^.cycles:= cycles;
  599.       iob^.request.message.node.pri:= priority;
  600.       iob^.identifier:= id;    (* for support of tell-me-when-note-starts *)
  601.       iob^.request.command:= write;  (* CMD_WRITE *)
  602.       iob^.request.flags:= pervol;  (* ADIOF_PERVOL *)
  603.       
  604.       (* Initialize message port.  If NIL, then no pushing back of a message.
  605.        * If nonzero, message gets recirculated by ReEmployIOB until
  606.        * the user finally acknowledges it by using MayGetNote. *)
  607.   
  608.        iob^.writeMsg.replyPort:= messageport;
  609.        IF (messageport # NIL) THEN
  610.           (*  "reply" to this message -  ADIOF_WRITEMESSAGE *)
  611.       iob^.request.flags:= iob^.request.flags + writeMessage;
  612.         END;
  613.         BeginIO(iob);
  614.         RETURN 0;      (* all went ok *)
  615.    END;
  616.   RETURN (outOfMemory);  (* (else-part) iob was zero, couldn't do the above. *)
  617.  END PlayXXXX;
  618.  
  619. (* PlayNote - starts a sound on the channel with specified period and volume.
  620.  * This nice little routine takes a note and plays it on the given
  621.  * voice.  The note is basically an integer from
  622.  * 0 to 11 (c to b) plus 12 per octave above the first and lowest, 
  623.  * which yields a note range of 0 to 95.
  624.  * The waveform to use is determined by adding an index (woffsets[]) 
  625.  * dependant on the octave to waveform in chipaudio[channel] as setup by
  626.  * SetWave.  The length of the waveform (in wlen[]) is likewise dependant
  627.  * on the octave.  Note that octaves start with zero, not one.
  628.  * The period and volume can be modified later, using SetPV.
  629.  *)
  630.  
  631. PROCEDURE PlayNote(channel: LONGINT;   (* specify channel number 0-3 *)
  632.                    note:    CARDINAL;  (* specify note number 0-95 *)
  633.                    volume:   CARDINAL;   (* volume 0-64  *)
  634.                    duration: CARDINAL; (* duration  1000ths of a sec. *)
  635.                    priority:   Byte;     (* force a range -128 to 127 *)
  636.                    messageport: MsgPortPtr;
  637.                    id: LONGINT);
  638.  VAR
  639.    error: LONGINT;
  640.    period, octave: CARDINAL;
  641.    ipart, jpart: CARDINAL;
  642.    length: LONGCARD;
  643.    wavepointer: ADDRESS;     (* where to find start of waveform *)
  644.    cycles: CARDINAL;
  645.  BEGIN
  646.    error:= IsThatMyChan(channel);
  647.    IF (error # 0) THEN RETURN; END;
  648.    
  649.    IF (note > 95) THEN note:= 95; END;
  650.    IF (volume > 64) THEN volume:=64; END;
  651.    octave:= note DIV 12;
  652.    
  653.    IF (chipaudio[channel] = 0) THEN RETURN; END; (* no SetWave or SetSamp !! *)
  654.    wavepointer:= chipaudio[channel] + ADDRESS(woffsets[octave]);
  655.    length:= wlen[octave];
  656.    period:= perval[note MOD 12];
  657.  
  658.    (* divide duration into two parts - ipart & jpart - for calculations *)   
  659.    IF (duration > 1000) THEN ipart:= duration DIV 1000; ELSE ipart:=0; END;
  660.    jpart:= duration - (ipart * 1000);
  661.    
  662.    (* fool it a little so we don't get integer overflow...             *)
  663.    (* 3.5 million times 1000 is about all we can take in a 32 bit word *)
  664.       
  665.    cycles:= ((LONGCARD(audClock) * ipart)+(LONGCARD(audClock) * jpart) DIV 1000)
  666.              DIV (LONGCARD(length) * period);
  667.    IF ((cycles = 0) AND (duration # 0)) THEN cycles:= 1; END;
  668.    
  669.   error:= PlayXXXX(channel,wavepointer,length,period,volume,cycles,
  670.                    priority,messageport,id);
  671.   RETURN       (* just ignore error *)         
  672.  END PlayNote;
  673.  
  674.  
  675. (* PlayFreq - in this version is for scalar values of frequency only.
  676.  * Minimum value is 28Hz, practical maximum is about 7000Hz. 
  677.  * Period is calculated from frequency to within 127 to 500, otherwise, 
  678.  * if the frequency is out of range of what we have in our wave tables
  679.  * currently, we have to reject the command.
  680.  *)
  681.  
  682. PROCEDURE PlayFreq(channel: LONGINT;    (* specify channel number 0-3 *)
  683.                    freq:    CARDINAL;   (* specify scalar freq 28-7000 Hz *)
  684.                    volume:   CARDINAL;  (* volume 0-64 *)
  685.                    duration: CARDINAL;  (* 1000ths of a second *)
  686.                    priority:     Byte; (* force a range -128 to 127 *)
  687.                    messageport: MsgPortPtr;  (* for use by MayGetNote *)
  688.                    id: LONGINT);
  689.  VAR
  690.    error: LONGINT;
  691.    period, octave: CARDINAL;
  692.    ipart, jpart: CARDINAL;
  693.    length: LONGCARD;
  694.    wavepointer: ADDRESS;   (* where to find start of waveform *)
  695.    cycles: CARDINAL;
  696.    i: CARDINAL;
  697.    accept: BOOLEAN;
  698.  BEGIN
  699.    error:= IsThatMyChan(channel);
  700.    IF (error # 0) THEN RETURN; END;
  701.  
  702.    IF (freq = 0) THEN RETURN; END;
  703.    IF (volume > 64) THEN volume:= 64; END;
  704.  
  705.    i:= 0;  (* see if we CAN represent this frequency, if not, reject it *)
  706.    LOOP                  (* figure out which waveform to use... *)
  707.      octave:= i;         (* start with the first wlen value because *)
  708.      accept:= FALSE;     (* we want to use the longest waveform we can. *)
  709.      period:= LONGCARD(audClock) DIV (LONGCARD(freq) * (wlen[octave]));
  710.      IF (period > 500) THEN EXIT; END; (* freq less than 28Hz. *)
  711.      IF (period > 127) THEN accept:= TRUE; EXIT; END;
  712.      i:=i+1; IF (i > 8) THEN EXIT; END;
  713.    END;
  714.    IF (accept = FALSE) THEN RETURN; END;  (* reject it *)
  715.  
  716.    IF (chipaudio[channel] = 0) THEN RETURN; END; (* no SetWave or SetSamp !! *) 
  717.    wavepointer:= chipaudio[channel] + ADDRESS(woffsets[octave]);
  718.    length:= wlen[octave];
  719.       
  720.    (* divide duration into two parts - ipart & jpart - for calculations *)
  721.    IF (duration > 1000) THEN ipart:= duration DIV 1000; ELSE ipart:=0; END;
  722.    jpart:= duration - (ipart * 1000);
  723.    
  724.    (* fool it a little so we don't get integer overflow...           *)
  725.    (* 3.5 million times 1000 is about all we can take in a 32 bit word *)
  726.       
  727.    cycles:= (LONGCARD(freq) * ipart) + (LONGCARD(freq) * jpart) DIV 1000;
  728.    IF ((cycles = 0) AND (duration # 0)) THEN cycles:= 1; END;
  729.        
  730.   error:= PlayXXXX(channel,wavepointer,length,period,volume,cycles,
  731.                    priority,messageport,id);
  732.   RETURN        (* just ignore error *)        
  733.  END PlayFreq;
  734.  
  735.  
  736. (* MayGetNote - is used to synchronize the Play audio routines, using
  737.  * messageport and id, (parameters of the Play routines).
  738.  * where uport is the pointer to the port you received from InitAudio.
  739.  * 
  740.  *  when flag = FALSE, the routine returns immediately, with an id = 0 
  741.  *  (no id available), or the value of the first id to arrive at the port.
  742.  *
  743.  *  when flag = TRUE, the routine will wait if (and only if) there is no id.
  744.  *  In other words, you can cause your task to go to sleep until the 
  745.  *  next note begins to play.  You decide what to do for a specific note.
  746.  *
  747.  *   CAUTION - if there are no more notes with messageport nonzero in
  748.  *         the queue and you specify TRUE for the flag, you can cause your
  749.  *         task to sleep forever!!
  750.  *)
  751.  
  752. PROCEDURE MayGetNote(uport: MsgPortPtr; flag: BOOLEAN): LONGINT;
  753.  VAR
  754.    aum: auMsgPtr;
  755.  
  756.  BEGIN 
  757.   LOOP
  758.    aum:= auMsgPtr(GetMsg(uport));   (* is a message there? *)
  759.  
  760.    IF (aum # NIL) THEN  (* There was a message! *) 
  761.       (* The user has seen this msg, so the system can deallocate
  762.        * the iob in which it occurs anytime in the future.
  763.        * Now that we have received the message at our own reply
  764.        * port, it belongs to us and we can do whatever we want
  765.        * to it.  Set the reply port value to zero now, as a signal
  766.        * to FreeIOB that it can really do that! 
  767.        *)
  768.       aum^.message.replyPort:= NIL;
  769.       EXIT;  (* from LOOP with message *)
  770.    END;
  771.    IF (flag = TRUE) THEN
  772.       (* let caller sleep while waiting for any identified iob to appear. *)
  773.       WaitPort(uport);  (* Note: WaitPort does NOT remove message from port *)
  774.       flag:= FALSE;
  775.    END;
  776.   END;
  777.  RETURN (aum^.identifier);  (* return the LONG value *)  
  778. END MayGetNote;
  779.  
  780.  
  781. (* PlaySamp - play a sampled sound:
  782.  *  Identical to PlayFreq but the parameters are interpreted differently.
  783.  *  "freq" now becomes "period" interpreted as sampling_rate, 
  784.  *  must be in the range of 127 to 500.
  785.  *  "duration" still is expressed in 1000ths of a second to play it.
  786.  *  (as with the audio device itself, a duration of 0 means do it forever
  787.  *   or until the audio device is reset or the channel is flushed or
  788.  *   until this command is explicitly aborted.)
  789.  *)
  790.  
  791. PROCEDURE PlaySamp(channel: LONGINT;   (* specify channel number 0-3 *)
  792.                    period:  CARDINAL;   (* period value 127 to 500 *)
  793.                    volume:    CARDINAL; (* volume 0-64 *)
  794.                    duration: CARDINAL;  (* 1000ths of a second *)
  795.                    priority:     Byte;  (* force a range -128 to 127 *)
  796.                    messageport: MsgPortPtr;  (* for use by MayGetNote *)
  797.                    id: LONGINT);
  798. VAR
  799.   error: LONGINT;
  800.   wavepointer: ADDRESS;   (* where to find start of sample to play *)
  801.   cycles: CARDINAL;
  802.   ipart, jpart: CARDINAL;
  803.   length: LONGCARD;
  804.  BEGIN
  805.    error:= IsThatMyChan(channel);
  806.    IF (error # 0) THEN RETURN; END;
  807.  
  808.    IF (period > 500) THEN period:= 500;   (* Note: or reject it ? *)
  809.    ELSIF (period < 127) THEN period:= 127; END;
  810.    
  811.    IF (volume > 64) THEN volume:= 64; END;
  812.    
  813.    IF (chipaudio[channel] = 0) THEN RETURN; END; (* no SetWave or SetSamp !! *)
  814.    wavepointer:= chipaudio[channel];
  815.    length:= datalength[channel]; (* as set by SetSamp *)
  816.    
  817.    (* divide duration into two parts - ipart & jpart - for calculations *)
  818.    IF (duration > 1000) THEN ipart:= duration DIV 1000; ELSE ipart:=0; END;
  819.    jpart:= duration - (ipart * 1000);
  820.  
  821.    (* fool it a little so we don't get integer overflow...           *)
  822.    (* 3.5 million times 1000 is about all we can take in a 32 bit word *)
  823.     
  824.    cycles:= ((LONGCARD(audClock) * ipart)+(LONGCARD(audClock) * jpart) DIV 1000)
  825.              DIV (LONGCARD(length) * period);
  826.    IF ((cycles = 0) AND (duration # 0)) THEN cycles:= 1; END;
  827.  
  828.   error:= PlayXXXX(channel,wavepointer,length,period,volume,cycles,
  829.                    priority,messageport,id);
  830.   RETURN        (* just ignore error *)                
  831.  END PlaySamp;
  832.  
  833.  
  834. (* If the user says FinishAudio, IT MEANS FINISH AUDIO.
  835.  * Flush anything that is still in play, NOW.  You can
  836.  * use "CheckIfDone()" to see if everything is finished
  837.  * BEFORE you call FinishAudio.  If CheckIfDone() is
  838.  *  (FALSE), it means that something is still playing.
  839.  *)
  840.  
  841. PROCEDURE FinishAudio(uport: MsgPortPtr);
  842.  VAR
  843.    error: LONGINT;
  844.    aum: auMsgPtr;    (* A little bigger than a standard message, *)
  845.    i: LONGINT;       (* but this routine will not really know    *)
  846.                      (* (or care) about the difference. *)
  847.  BEGIN  
  848.    IF (uport # NIL) THEN
  849.       FOR i:=0 TO maxChan-1 BY 1 DO
  850.          error:= FlushChannel(i);   (* error is dummy function return *) 
  851.       END;
  852.       
  853.       WHILE (CheckIOBDone() = FALSE) DO
  854.          Delay(12);   (* Be a good multitasking neighbor: sleep a little  *)
  855.       END;
  856.       
  857.       aum:= auMsgPtr(GetMsg(uport));  (* prepare to empty the port *)
  858.       WHILE (aum # NIL) DO
  859.          aum^.message.replyPort:= NIL;      (* let system deallocate it *)
  860.          aum:= auMsgPtr(GetMsg(uport));
  861.       END;
  862.       
  863.       ReEmployIOB();   (* free all static and dynamic messages *)
  864.  
  865.       FOR i:=0 TO maxChan-1 BY 1 DO
  866.         error:= FreeChannel(i);   (* error is dummy function return *)
  867.       END;
  868.       DeletePort(uport);
  869.    END;
  870.    
  871.    IF (device # NIL) THEN CloseDevice(ADR(openIOB)); END;
  872.    FOR i:=0 TO maxChan-1 BY 1 DO
  873.      IF (chipaudio[i] # 0) THEN
  874.         FreeMem(chipaudio[i], datalength[i]);
  875.         chipaudio[i]:= 0; datalength[i]:= 0;
  876.      END;
  877.      IF (replyPort[i] # NIL) THEN DeletePort(replyPort[i]); END;
  878.    END;
  879.    IF (controlPort # NIL) THEN DeletePort(controlPort); END;
  880.  
  881.  END FinishAudio;
  882.  
  883. END AudioTools.imp
  884.  
  885.